home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / forth / hence4th.lha / hence4th / words2.m4 < prev    next >
Text File  |  1993-02-02  |  4KB  |  149 lines

  1.  
  2. dnl    WARNING: This file is part of the Hence4th Development System
  3. dnl            DO NOT REDISTRIBUTE! 
  4. dnl
  5. dnl
  6. dnl    HenceFORTH in C
  7. dnl    (c) Copyright 1990  MISSING LINK
  8. dnl    All Rights Reserved
  9. dnl
  10. dnl
  11. dnl    File:    words2.m4
  12. dnl    Desc:    Forth secondary definitions
  13. dnl        
  14. dnl        
  15. Include(`m4header')
  16.  
  17. cinclude("words2.h")
  18.  
  19. Linkto(dashdup)
  20.  
  21. nucleus
  22.  
  23. Word(`traverse',,`SWAP BEGIN OVER PLUS LIT(0x7F) OVER CFETCH LESS UNTIL
  24.     SWAP DROP')
  25.  
  26. Word(`latest',,`CURRENT FETCH FETCH')
  27.  
  28. Word(`lfa',,`LIT( 2 * sizeof(a_cell)) SUBTRACT')
  29.  
  30. Word(`cfa',,`LIT(sizeof(a_cell)) SUBTRACT')
  31.  
  32. Word(`nfa',,`LIT(2 * sizeof(a_cell) + 1) SUBTRACT LIT(-1) TRAVERSE')
  33.  
  34. Word(`pfa',,`ONE TRAVERSE LIT(2 * sizeof(a_cell) + 1) PLUS  ALIGN')
  35.  
  36. Word(`storecsp',`!csp',`SPFETCH CSP STORE')
  37.  
  38. Word(`qerror',`?error',`SWAP IF  ERROR  ELSE  DROP  ENDIF')
  39.  
  40. Word(`qcomp',`?comp',`STATE FETCH ZEROEQUALS LIT(0x11) QERROR')
  41.  
  42. Word(`qexec',`?exec',`STATE FETCH LIT(0x12) QERROR')
  43.  
  44. Word(`qpairs',`?pairs',`SUBTRACT LIT(0x13) QERROR')
  45.  
  46. Word(`qcsp',`?csp',`SPFETCH CSP FETCH SUBTRACT LIT(0x14) QERROR')
  47.  
  48. Word(`qloading',`?loading',`BLK FETCH ZEROEQUALS LIT(0x16) QERROR')
  49.  
  50. Word(`compile',,`QCOMP LIT(ip) DUP LIT(sizeof(a_cell)) PLUS
  51.     ip = (char *) pop; FETCH COMMA')
  52.  
  53. compilers
  54.  
  55. Word(`leftbracket',`[',`ZERO STATE STORE')
  56.  
  57. nucleus
  58.  
  59. Word(`rightbracket',`]',`LIT(0xC0) STATE STORE')
  60.  
  61. Word(`smudge',,`LATEST LIT(0x20) TOGGLE')
  62.  
  63. Word(`hex',,`LIT(0x10) BASE STORE')
  64.  
  65. Word(`decimal',,`LIT(10) BASE STORE')
  66.  
  67. Word(`psemicode',`\050;code\051',`push(ip); LATEST PFA CFA STORE SEMIS')
  68.  
  69. Word(`semicode',`;code',`QCSP COMPILE(psemicode) /*[COMPILE]*/ LEFTBRACKET')
  70.  
  71. Word(`builds',`<builds',`ZERO CONSTANT')
  72.  
  73. nucleus
  74.  
  75. Word(`does',`does>',`push(ip); LATEST PFA STORE SEMICODE(dodoes) SEMIS')
  76.  
  77. Word(`count',,`DUP ONEPLUS SWAP CFETCH')
  78.  
  79. Word(`dashtrailing',`-trailing',`DUP ZERO DO  OVER OVER  PLUS ONE SUBTRACT
  80.     CFETCH BL SUBTRACT IF LEAVE ELSE ONE SUBTRACT ENDIF  LOOP')
  81.  
  82. Word(`pdotquote',`\050.\"\051',`LIT(ip) COUNT DUP  ONEPLUS
  83.      LIT(ip) PLUS  ALIGN  ip = (char *)pop;  TYPE')
  84.  
  85. compilers
  86.  
  87. Word(`dotquote',`.\"',`LIT(0x22) STATE FETCH  IF  COMPILE(pdotquote)
  88.     WORD HERE CFETCH ONEPLUS ALLOT HERE ALIGN DP STORE
  89.     ELSE  WORD HERE COUNT TYPE ENDIF')
  90.  
  91. nucleus
  92.  
  93. Word(`expect',,`OVER PLUS OVER DO KEY DUP LIT(0X0E) PLUSORIGIN FETCH
  94.     EQUALS IF DROP  LIT(8) OVER I EQUALS  DUP  RFROM  TWO SUBTRACT
  95.     PLUS  TOR  SUBTRACT ELSE  DUP  LIT(EOL) EQUALS IF  LEAVE  DROP
  96.     BL  ZERO  ELSE DUP  ENDIF  I CSTORE  ZERO I ONEPLUS CSTORE  ZERO
  97.     I TWOPLUS CSTORE  ENDIF  EMIT  LOOP  DROP')
  98.  
  99. Word(`query',,`TIB FETCH LIT(0x50) EXPECT  ZERO IN STORE')
  100.  
  101. compilers
  102.  
  103. Word(`null',`\000',`BLK FETCH  IF  ONE BLK PLUSSTORE  ZERO IN STORE
  104.     BLK FETCH LIT(1024 / BPERBUF - 1) AND ZEROEQUALS IF QEXEC
  105.     /* RFROM DROP */ SEMIS  ENDIF  ELSE /* RFROM DROP */ SEMIS  ENDIF')
  106.  
  107. nucleus
  108.  
  109. Word(`fill',,`SWAP TOR  OVER CSTORE  DUP ONEPLUS  RFROM ONE SUBTRACT CMOVE')
  110.  
  111. Word(`erasee',`erase',`ZERO FILL')
  112.  
  113. Word(`blanks',,`BL FILL')
  114.  
  115. Word(`hold',,`LIT(-1) HLD PLUSSTORE  HLD FETCH CSTORE')
  116.  
  117. Word(`pad',,`HERE LIT(0X44) PLUS')
  118.  
  119. Word(`word',,`BLK FETCH IF  BLK FETCH  BLOCK  ELSE  TIB FETCH  ENDIF
  120.     IN FETCH PLUS SWAP  ENCLOSE  HERE LIT(0X22) BLANKS
  121.     IN PLUSSTORE  OVER SUBTRACT TOR  R HERE CSTORE
  122.     PLUS HERE ONEPLUS  RFROM CMOVE')
  123.  
  124. Word(`pnumber',`\050number\051',`BEGIN ONEPLUS DUP TOR  CFETCH BASE FETCH
  125.     DIGIT  WHILE  SWAP  BASE FETCH USTAR  DROP ROT
  126.     BASE FETCH USTAR DPLUS
  127.     DPL FETCH  ONEPLUS IF  ONE DPL PLUSSTORE
  128.     ENDIF  RFROM  REPEAT  RFROM')
  129.  
  130. Word(`number',,`ZERO ZERO ROT DUP ONEPLUS CFETCH LIT(0X2D) EQUALS DUP TOR
  131.     PLUS LIT(-1) BEGIN  DPL STORE PNUMBER  DUP CFETCH BL SUBTRACT
  132.     WHILE  DUP CFETCH LIT(0X2E) SUBTRACT ZERO QERROR
  133.     ZERO REPEAT  DROP RFROM  IF DMINUS  ENDIF')
  134.  
  135. Word(`dashfind',`-find',`BL WORD  HERE CONTEXT FETCH FETCH PFIND
  136.     DUP ZEROEQUALS IF  DROP HERE LATEST PFIND ENDIF')
  137.  
  138. Word(`pabort',`\050abort\051',`ABORT')
  139.  
  140. constants
  141.  
  142. Word(`errornumber',`error#',`(cell) &errno')
  143.  
  144. nucleus
  145.  
  146. Word(`error',,`WARNING FETCH  ZEROLESS IF  PABORT  ENDIF  HERE COUNT TYPE
  147.     DOTQUOTE("  ? ") MESSAGE  SPSTORE  IN FETCH  BLK FETCH QUIT')
  148.  
  149.